module memory_mod

use global_mod,     only: ink, rlk
use utils_misc_mod, only: Critical_Error, ARROW_ERR_MEM_ASSOC, ARROW_ERR_MEM_ALLOC
use utils_misc_mod, only: ARROW_ERR_MEM_DEALLOC

implicit none

real(kind=rlk),    parameter :: ARROW_REAL_DEF = -2.0e8
integer(kind=ink), parameter :: ARROW_INT_DEF  = -200000000

integer(kind=ink), private :: mem_usage = 0

interface Allocate
  module procedure Allocate_Real_Vec
  module procedure Allocate_Real_Arr
  module procedure Allocate_Integer_Vec
  module procedure Allocate_Integer_Arr
end interface

interface Deallocate
  module procedure Deallocate_Real_Vec
  module procedure Deallocate_Real_Arr
  module procedure Deallocate_Integer_Vec
  module procedure Deallocate_Integer_Arr
end interface

interface Resize
  module procedure Resize_Real_Vec
  module procedure Resize_Real_Arr
end interface

contains

subroutine Allocate_Real_Vec(vec, nn)
  real(kind=rlk),    pointer    :: vec(:)
  integer(kind=ink), intent(in) :: nn
  integer(kind=ink) :: ierr
  if (associated(vec)) call Critical_Error(ARROW_ERR_MEM_ASSOC, "Allocate_Real_Vec")
  allocate(vec(nn), stat=ierr)
  if (ierr/=0) call Critical_Error(ARROW_ERR_MEM_ALLOC, "Allocate_Real_Vec")
  mem_usage = mem_usage + nn*rlk
end subroutine Allocate_Real_Vec


subroutine Deallocate_Real_Vec(vec)
  real(kind=rlk), pointer :: vec(:)
  integer(kind=ink) :: ierr
  if (.not.associated(vec)) call Critical_Error(ARROW_ERR_MEM_ASSOC, "Deallocate_Real_Vec")
  deallocate(vec, stat=ierr)
  if (ierr/=0) call Critical_Error(ARROW_ERR_MEM_DEALLOC, "Deallocate_Real_Vec")
  mem_usage = mem_usage - size(vec)*rlk
end subroutine Deallocate_Real_Vec


function Resize_Real_Vec(vec, nn) result(pvec)
  real(kind=rlk),    pointer    :: vec(:)
  integer(kind=ink), intent(in) :: nn
  real(kind=rlk),    pointer    :: pvec(:)
  integer(kind=ink) :: ii
  call Allocate(pvec, nn)
  do ii=1,min(size(vec), nn)
    pvec(ii) = vec(ii)
  enddo
  call Deallocate(vec)
  vec => pvec
end function Resize_Real_Vec


subroutine Allocate_Real_Arr(arr, nn, mm)
  real(kind=rlk),    pointer    :: arr(:,:)
  integer(kind=ink), intent(in) :: nn
  integer(kind=ink), intent(in) :: mm
  integer(kind=ink) :: ierr
  if (associated(arr)) call Critical_Error(ARROW_ERR_MEM_ASSOC, "Allocate_Real_Arr")
  allocate(arr(nn,mm), stat=ierr)
  if (ierr/=0) call Critical_Error(ARROW_ERR_MEM_ALLOC, "Allocate_Real_Arr")
  mem_usage = mem_usage + nn*mm*rlk
end subroutine Allocate_Real_Arr


subroutine Deallocate_Real_Arr(arr)
  real(kind=rlk), pointer :: arr(:,:)
  integer(kind=ink) :: ierr
  if (.not.associated(arr)) call Critical_Error(ARROW_ERR_MEM_ASSOC, "Deallocate_Real_Arr")
  deallocate(arr, stat=ierr)
  if (ierr/=0) call Critical_Error(ARROW_ERR_MEM_DEALLOC, "Deallocate_Real_Arr")
  mem_usage = mem_usage - size(arr,1)*size(arr,2)*rlk
end subroutine Deallocate_Real_Arr


function Resize_Real_Arr(arr, nn, mm) result(parr)
  real(kind=rlk),    pointer    :: arr(:,:)
  integer(kind=ink), intent(in) :: nn
  integer(kind=ink), intent(in) :: mm
  real(kind=rlk),    pointer    :: parr(:,:)
  integer(kind=ink) :: ii, jj
  call Allocate(parr, nn, mm)
  do ii=1,min(size(arr,1), nn)
    do jj=1,min(size(arr,2), mm)
      parr(ii,jj) = arr(ii,jj)
    enddo
  enddo
  call Deallocate(arr)
  arr => parr
end function Resize_Real_Arr


subroutine Allocate_Integer_Vec(vec, nn)
  integer(kind=ink), pointer    :: vec(:)
  integer(kind=ink), intent(in) :: nn
  integer(kind=ink) :: ierr
  if (associated(vec)) call Critical_Error(ARROW_ERR_MEM_ASSOC, "Allocate_Integer_Vec")
  allocate(vec(nn), stat=ierr)
  if (ierr/=0) call Critical_Error(ARROW_ERR_MEM_ALLOC, "Allocate_Integer_Vec")
  mem_usage = mem_usage + nn*ink
end subroutine Allocate_Integer_Vec


subroutine Deallocate_Integer_Vec(vec)
  integer(kind=ink), pointer    :: vec(:)
  integer(kind=ink) :: ierr
  deallocate(vec, stat=ierr)
  if (ierr/=0) call Critical_Error(ARROW_ERR_MEM_DEALLOC, "Deallocate_Integer_Vec")
  mem_usage = mem_usage - size(vec,1)*ink
end subroutine Deallocate_Integer_Vec


function Resize_Integer_Vec(vec, nn) result(pvec)
  integer(kind=ink), pointer    :: vec(:)
  integer(kind=ink), intent(in) :: nn
  integer(kind=ink), pointer    :: pvec(:)
  integer(kind=ink) :: ii
  call Allocate(pvec, nn)
  do ii=1,min(size(vec), nn)
    pvec(ii) = vec(ii)
  enddo
  call Deallocate(vec)
  vec => pvec
end function Resize_Integer_Vec


subroutine Allocate_Integer_Arr(arr, nn, mm)
  integer(kind=ink), pointer    :: arr(:,:)
  integer(kind=ink), intent(in) :: nn
  integer(kind=ink), intent(in) :: mm
  integer(kind=ink) :: ierr
  if (associated(arr)) call Critical_Error(ARROW_ERR_MEM_ASSOC, "Allocate_Integer_Arr")
  allocate(arr(nn,mm), stat=ierr)
  if (ierr/=0) call Critical_Error(ARROW_ERR_MEM_ALLOC, "Allocate_Integer_Arr")
  mem_usage = mem_usage - size(arr,1)*size(arr,2)*ink
end subroutine Allocate_Integer_Arr


subroutine Deallocate_Integer_Arr(arr)
  integer(kind=ink), pointer :: arr(:,:)
  integer(kind=ink) :: ierr
  if (.not.associated(arr)) call Critical_Error(ARROW_ERR_MEM_ASSOC, "Deallocate_Integer_Arr")
  deallocate(arr, stat=ierr)
  if (ierr/=0) call Critical_Error(ARROW_ERR_MEM_DEALLOC, "Deallocate_Integer_Arr")
  mem_usage = mem_usage - size(arr,1)*size(arr,2)*ink
end subroutine Deallocate_Integer_Arr


function Resize_Integer_Arr(arr, nn, mm) result(parr)
  integer(kind=ink), pointer    :: arr(:,:)
  integer(kind=ink), intent(in) :: nn
  integer(kind=ink), intent(in) :: mm
  integer(kind=ink), pointer    :: parr(:,:)
  integer(kind=ink) :: ii, jj
  call Allocate(parr, nn, mm)
  do ii=1,min(size(arr,1), nn)
    do jj=1,min(size(arr,2), mm)
      parr(ii,jj) = arr(ii,jj)
    enddo
  enddo
  call Deallocate(arr)
  arr => parr
end function Resize_Integer_Arr


end module memory_mod
